home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / comcorn / AutoEvents / ServAuto.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-03-01  |  2.9 KB  |  103 lines
  1. unit ServAuto;
  2.  
  3. interface
  4.  
  5. uses
  6.   ComObj, ActiveX, AxCtrls, Server_TLB;
  7.  
  8. type
  9.   TServerWithEvents = class(TAutoObject, IConnectionPointContainer, IServerWithEvents)
  10.   private
  11.     { Private declarations }
  12.     FConnectionPoints: TConnectionPoints;
  13.     FObjRegHandle: Integer;
  14.     procedure MemoChange(Sender: TObject);
  15.   protected
  16.     { Protected declarations }
  17.     procedure AddText(const NewText: WideString); safecall;
  18.     procedure Clear; safecall;
  19.     function GetConnectionEnumerator: IEnumConnections;
  20.     property ConnectionPoints: TConnectionPoints read FConnectionPoints
  21.       implements IConnectionPointContainer;
  22.   public
  23.     destructor Destroy; override;
  24.     procedure Initialize; override;
  25.   end;
  26.  
  27. implementation
  28.  
  29. uses Windows, ComServ, ServMain, SysUtils, StdCtrls;
  30.  
  31. destructor TServerWithEvents.Destroy;
  32. begin
  33.   inherited Destroy;
  34.   RevokeActiveObject(FObjRegHandle, nil);  // Make sure I'm removed from ROT
  35. end;
  36.  
  37. procedure TServerWithEvents.Initialize;
  38. begin
  39.   inherited Initialize;
  40.   FConnectionPoints := TConnectionPoints.Create(Self);
  41.   if AutoFactory.EventTypeInfo <> nil then
  42.     FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID, ckMulti,
  43.       EventConnect);
  44.   // Route main form memo's OnChange event to MemoChange method:
  45.   MainForm.Memo.OnChange := MemoChange;
  46.   // Register this object with COM's Running Object Table (ROT) so other
  47.   // clients can connect to this instance.
  48.   RegisterActiveObject(Self as IUnknown, Class_ServerWithEvents,
  49.     ACTIVEOBJECT_WEAK, FObjRegHandle);
  50. end;
  51.  
  52. procedure TServerWithEvents.Clear;
  53. var
  54.   EC: IEnumConnections;
  55.   ConnectData: TConnectData;
  56.   Fetched: Cardinal;
  57. begin
  58.   MainForm.Memo.Lines.Clear;
  59.   EC := GetConnectionEnumerator;
  60.   if EC <> nil then
  61.   begin
  62.     while EC.Next(1, ConnectData, @Fetched) = S_OK do
  63.       if ConnectData.pUnk <> nil then
  64.         (ConnectData.pUnk as IServerWithEventsEvents).OnClear;
  65.   end;
  66. end;
  67.  
  68. procedure TServerWithEvents.AddText(const NewText: WideString);
  69. begin
  70.   MainForm.Memo.Lines.Add(NewText);
  71. end;
  72.  
  73. procedure TServerWithEvents.MemoChange(Sender: TObject);
  74. var
  75.   EC: IEnumConnections;
  76.   ConnectData: TConnectData;
  77.   Fetched: Cardinal;
  78. begin
  79.   EC := GetConnectionEnumerator;
  80.   if EC <> nil then
  81.   begin
  82.     while EC.Next(1, ConnectData, @Fetched) = S_OK do
  83.       if ConnectData.pUnk <> nil then
  84.         (ConnectData.pUnk as IServerWithEventsEvents).OnTextChanged((Sender as TMemo).Text);
  85.   end;
  86. end;
  87.  
  88. function TServerWithEvents.GetConnectionEnumerator: IEnumConnections;
  89. var
  90.   Container: IConnectionPointContainer;
  91.   CP: IConnectionPoint;
  92. begin
  93.   Result := nil;
  94.   OleCheck(QueryInterface(IConnectionPointContainer, Container));
  95.   OleCheck(Container.FindConnectionPoint(AutoFactory.EventIID, CP));
  96.   CP.EnumConnections(Result);
  97. end;
  98.  
  99. initialization
  100.   TAutoObjectFactory.Create(ComServer, TServerWithEvents,
  101.     Class_ServerWithEvents, ciMultiInstance, tmApartment);
  102. end.
  103.